GS <- mutate(GS,Date = as.Date(Date, format = "%d-%b-%y"))
GSxts <- tk_xts(GS)
## Warning in tk_xts_.data.frame(data = data, select = select, date_var =
## date_var, : Non-numeric columns being dropped: Date
## Using column `Date` for date_var.
allDates = index(GSxts)
firstDate <- min(allDates)
lastDate <- max(allDates)-30 #find the last start_date
while(!lastDate %in% allDates)
lastDate <- lastDate-1
result <- data.frame(`StartDate` = as.Date(character()), `OptionPnL` = double(), `HedgingPnL` = double(), `FinalPnL` = double(), `MaxDrawdown` = double(), `SharpeRatio` = double(),`StartPrice`= double(), `EndPrice` = double(), `AvgPrice` = double(), `AvgGrowthRate` = double(), `Volatility` = double(), `Profitability` = double())
startD <- firstDate
for(startD in firstDate:lastDate){
startD <- as.Date(startD)
if(startD %in% allDates){
endD <- startD+30
#adjust the end date backwards if end date (a calendar day) is not in the xts
while(!endD %in% allDates)
endD <- endD-1
xts_obj <- GSxts[paste(c(startD,endD),collapse = "/")]
quantity = 100
dates <- index(xts_obj)
start_date <- min(dates)
end_date <- max(dates)
start_price <- as.numeric(xts_obj[start_date, "Close"])
start_volatility <- as.numeric(xts_obj[start_date, "IV30"])
df <- tibble(Date = dates)
df$Close <- coredata(xts_obj[, "Close"])
#df$IV30 <- coredata(xts_obj[, "IV30"])
avgChange <- as.numeric(mean(xts_obj[, "PChg"],na.rm=TRUE))
#X <- start_price
#sigma = start_volatility
r <- 0.8 / 100
# Vary S and Time everyday
#S <- df$Close
#Time <- (end_date - df$Date) / 365
#GBSOption(TypeFlag, S, X, Time, r, b, sigma)@price
df_opt <- rowwise(df) %>%
#this is the premium for one unit of call option
mutate(premium = GBSOption(TypeFlag = "c",
S = Close,
X = as.numeric(start_price),
Time = as.numeric((end_date - Date) / 365),
r = r, # interest rate
b = 1.85/100, # dividend yield obtained from https://www.dividend.com/dividend-stocks/financial/investment-brokerage-national/gs-goldman-sachs/
sigma = as.numeric(start_volatility/100))@price,
#this is the delta of a call option (before negation)
delta_hedge = GBSGreeks("delta", TypeFlag = "c",
S = Close,
X = as.numeric(start_price),
Time = as.numeric((end_date - Date) / 365),
r = r,
b = 1.85/100,
sigma = as.numeric(start_volatility/100))) %>%
ungroup() %>%
#delta hedging strategy selected: SHORT CALL LONG STOCK (from BlackS Scholes formula, such strategy should approximate a long position in risk free)
mutate(Option_DoD_PnL = ifelse(Date == start_date, # On the 1st date, we count the cost of buying the option
0, #quantity*premium, #on the first day, receive the call option premium and short the option
-quantity*(premium - Lag(premium))), #if subsequently call option price rises, there is a loss
Hedging_DoD_Pnl = ifelse(Date == start_date, 0, quantity * Lag(delta_hedge) * (Close - Lag(Close))),
DoD_PnL = Option_DoD_PnL + Hedging_DoD_Pnl) %>%
mutate(PortValue = quantity*(-premium + delta_hedge*Close),
Profitability = DoD_PnL/Lag(PortValue),
PnL_to_date = cumsum(DoD_PnL),
HPnL_to_date = cumsum(Hedging_DoD_Pnl),
OPnL_to_date = cumsum(Option_DoD_PnL))
maxDrawDown <- {
xs <- df_opt$PnL_to_date
max(cummax(xs) - cummin(xs))
}
#The initial outflow of funds is the cost to buy stocks minus option premium received
#InitialInvt = (df_opt[[1,"delta_hedge"]]*df_opt[[1,"Close"]] - df_opt[[1,"premium"]])*quantity #OUTFLOW of funds
#profitability = df_opt[df_opt$Date==end_date,"PnL_to_date"]/InitialInvt
#df_opt<-mutate(df_opt, PortValue = InitialInvt + PnL_to_date, PortReturn = DoD_PnL/Lag(PortValue))
#ggplotly(p=ggplot(df_opt) + geom_line(aes(TTM,Option_DoD_PnL),color = "blue") + ggtitle("option profit - TTM"))
#ggplotly(p=ggplot(df_opt) + geom_line(aes(TTM,Hedging_DoD_Pnl))+ggtitle("stock profit - TTM"))
#renderTable(tail(df_opt,1))
#renderText(paste0("the Sharpe Ratio is ",round(SR,4)))
#renderText(paste0("The maximum drawdown is ", round(maxDrawDown,4)))
hedgingPnl <- as.numeric(df_opt[df_opt$Date==end_date,"HPnL_to_date"])
finalPnl <- as.numeric(df_opt[df_opt$Date==end_date,"PnL_to_date"])
optionPnl <- as.numeric(df_opt[df_opt$Date==end_date,"OPnL_to_date"])
endPrice <- as.numeric(df_opt[df_opt$Date==end_date,"Close"])
avgPrice <- as.numeric(mean(df_opt$Close,na.rm=TRUE))
volatility <- stdev(df_opt$Profitability, na.rm = TRUE)*sqrt(252) #annualised volatility
profitability <- 12*(as.numeric(tail(cumprod(na.omit(df_opt$Profitability+1)),1))-1) #annualized profitability
SR <- as.numeric((profitability-r)/volatility) # annual SR
result <- rbind(result,data.frame("StartDate" = start_date, "OptionPnL" = optionPnl, "HedgingPnL" = hedgingPnl, "FinalPnL" = finalPnl, "MaxDrawdown" = maxDrawDown, "SharpeRatio" = SR,"StartPrice"=start_price , "EndPrice" = endPrice, "AvgPrice" = avgPrice, "AvgGrowthRate" = avgChange, "Volatility" = volatility, "Profitability" = profitability))
}}
ggplotly(p = ggplot(GS) + geom_line(aes(Date, Close, label = PChg))+ggtitle("Stock Price with percentage change")) #stock close price
## Warning: Ignoring unknown aesthetics: label
ggplot(GS) + geom_density(aes(Close)) #density of close price

ggplot(result) + geom_density(aes(MaxDrawdown)) + ggtitle("distribution of max drawdown")

kable(result%>% summarise(`MDD Mean` = mean(MaxDrawdown),`MDD volatility` = stdev(MaxDrawdown, na.rm = TRUE), `MDD Median` = median(MaxDrawdown))) %>% kable_styling(bootstrap_options = c("striped","hover"))
|
MDD Mean
|
MDD volatility
|
MDD Median
|
|
244.986
|
211.6976
|
180.2422
|
kable(result%>% summarise(`Mean Profitability` = mean(Profitability),`return volatility` = stdev(Profitability, na.rm = TRUE), `Mean PnL` = mean(FinalPnL), `PnL Volatility` = stdev(FinalPnL))) %>% kable_styling(bootstrap_options = c("striped","hover"))
|
Mean Profitability
|
return volatility
|
Mean PnL
|
PnL Volatility
|
|
-0.4458225
|
1.987506
|
-64.60084
|
284.6956
|
kable(result%>% summarise(`99% VAR` = -min(quantile(FinalPnL,.01),0),`95% VAR` = -min(quantile(FinalPnL,0.05),0))) %>% kable_styling(bootstrap_options = c("striped","hover"))
|
99% VAR
|
95% VAR
|
|
1000.471
|
711.4319
|
ggplot(result) + geom_density(aes(FinalPnL),color = "blue") +
geom_density(aes(OptionPnL),color = "red") +
geom_density(aes(HedgingPnL)) + ggtitle("distribution of PnLs")

ggplotly(p=ggplot(result) + geom_point(aes(AvgPrice,FinalPnL, label = StartDate)) + ggtitle("avg price - final pnl"))
## Warning: Ignoring unknown aesthetics: label
ggplotly(p=ggplot(result) + geom_point(aes(AvgGrowthRate,FinalPnL, label = AvgPrice))+ggtitle("avg growth rate - final pnl"))
## Warning: Ignoring unknown aesthetics: label
ggplotly(p=ggplot(result) + geom_point(aes(StartPrice,FinalPnL, label = EndPrice))+ggtitle("start price - final pnl"))
## Warning: Ignoring unknown aesthetics: label
ggplotly(p=ggplot(result) + geom_point(aes(EndPrice,FinalPnL, label = StartPrice))+ggtitle("end price - final pnl"))
## Warning: Ignoring unknown aesthetics: label
p1 <- ggplot(result) + geom_point(aes(AvgPrice, OptionPnL)) + ggtitle("avg price - option pnl") #+ xlim(150,300) + ylim(150,300) + coord_fixed(ratio = 1)
p2 <- ggplot(result) + geom_point(aes(AvgPrice, HedgingPnL)) + ggtitle("avg price - hedging pnl") #+ xlim(150,300) + ylim(150,300) + coord_fixed(ratio = 1)
grid.arrange(p1,p2,nrow = 1)

a1 <- ggplot(result) + geom_point(aes(AvgGrowthRate,OptionPnL)) +
ggtitle("avg growth rate - option pnl")
a2 <- ggplot(result) + geom_point(aes(AvgGrowthRate,HedgingPnL)) +
ggtitle("avg growth rate - hedging pnl")
grid.arrange(a1,a2, nrow = 1)

a3 <- ggplot(result) + geom_point(aes(x = StartPrice, y = EndPrice, color = OptionPnL), size = 0.8, alpha = 0.7)+ggtitle("start & end price - option pnl") + xlim(150,280) + ylim(150,280) + coord_fixed(ratio = 1) + geom_abline(mapping = NULL, data = NULL, slope = 1, intercept = 0, show.legend = NA)
a4 <- ggplot(result) + geom_point(aes(x = StartPrice, y = EndPrice, color = HedgingPnL), size = 0.8, alpha = 0.7)+ggtitle("start & end price - hedging pnl") + xlim(150,280) + ylim(150,280) + coord_fixed(ratio = 1) + geom_abline(mapping = NULL, data = NULL, slope = 1, intercept = 0, show.legend = NA)
grid.arrange(a3,a4, nrow=1)

Comparing the the hedging and option PnL, we clearly see a hedging relationship between option and stock position in this strategy.As average growth rate increase, the dispersion of FinalPnL gets bigger, which means the portfolio has not been completely hedged.
Sharpe ratio doesn’t have significant correlation with average growth rate, which means hedging is relatively successful and the portfolio generally has less exposure to stock’s risk.
Comparing these results with the backtesting results of 25% delta options, the profitability and volitility are significantly smaller and less extreme.
kable(head(result,20))%>%kable_styling(bootstrap_options = c("striped","hover"))
|
StartDate
|
OptionPnL
|
HedgingPnL
|
FinalPnL
|
MaxDrawdown
|
SharpeRatio
|
StartPrice
|
EndPrice
|
AvgPrice
|
AvgGrowthRate
|
Volatility
|
Profitability
|
|
2017-12-13
|
463.0454
|
-168.53684
|
294.508593
|
294.5086
|
9.9100330
|
255.56
|
257.03
|
256.1119
|
-0.0000952
|
0.0302113
|
0.3073954
|
|
2017-12-14
|
441.4060
|
-163.08038
|
278.325614
|
287.2598
|
9.1438185
|
255.48
|
257.03
|
256.1395
|
0.0003000
|
0.0305846
|
0.2876602
|
|
2017-12-15
|
592.4204
|
-283.10487
|
309.315485
|
324.3859
|
7.9829667
|
257.17
|
257.03
|
256.1742
|
0.0003158
|
0.0589236
|
0.4783850
|
|
2017-12-18
|
629.6078
|
-431.73718
|
197.870624
|
319.7264
|
3.5074328
|
260.02
|
253.65
|
256.1125
|
-0.0007000
|
0.0781903
|
0.2822474
|
|
2017-12-19
|
644.4881
|
-427.02857
|
217.459540
|
335.8817
|
4.0982381
|
256.48
|
250.97
|
255.6600
|
-0.0018000
|
0.0455551
|
0.1946957
|
|
2017-12-20
|
555.9713
|
-372.84239
|
183.128916
|
318.5387
|
-1.1386019
|
255.18
|
256.12
|
255.6420
|
-0.0000500
|
0.1055910
|
-0.1122261
|
|
2017-12-21
|
659.1798
|
-417.25831
|
241.921539
|
301.0003
|
5.8096937
|
261.01
|
256.12
|
255.6663
|
0.0002105
|
0.1025522
|
0.6037971
|
|
2017-12-22
|
645.1820
|
-393.99104
|
251.190956
|
319.6960
|
5.6971431
|
258.97
|
256.12
|
255.3694
|
-0.0010556
|
0.1011386
|
0.5842012
|
|
2017-12-26
|
-477.5047
|
555.71383
|
78.209142
|
212.0976
|
1.2759400
|
257.72
|
269.03
|
256.8571
|
0.0018571
|
0.0431973
|
0.0631171
|
|
2017-12-27
|
-578.7691
|
649.42209
|
70.652979
|
195.4156
|
1.3296562
|
255.95
|
268.14
|
257.3533
|
0.0019524
|
0.0348957
|
0.0543993
|
|
2017-12-28
|
-533.5051
|
590.57885
|
57.073751
|
184.7936
|
0.9145182
|
256.50
|
268.14
|
257.4235
|
0.0024000
|
0.0375990
|
0.0423850
|
|
2017-12-29
|
-700.4934
|
782.79560
|
82.302253
|
187.6953
|
1.7764516
|
254.76
|
268.14
|
257.4721
|
0.0024211
|
0.0323652
|
0.0654952
|
|
2018-01-02
|
-1025.2362
|
1039.27684
|
14.040625
|
111.2124
|
-0.1385077
|
255.67
|
272.23
|
259.9432
|
0.0030909
|
0.0237767
|
0.0047067
|
|
2018-01-03
|
-61.6881
|
69.86149
|
8.173396
|
103.0052
|
-0.3816456
|
253.29
|
260.04
|
260.1418
|
0.0008636
|
0.0193968
|
0.0005973
|
|
2018-01-04
|
313.1923
|
-283.36460
|
29.827673
|
112.2717
|
0.4504615
|
256.83
|
260.04
|
260.4681
|
0.0013333
|
0.0252566
|
0.0193771
|
|
2018-01-05
|
176.1221
|
-147.80806
|
28.314053
|
105.5138
|
0.4630396
|
255.52
|
260.04
|
260.6500
|
0.0007000
|
0.0234081
|
0.0188389
|
|
2018-01-08
|
100.8751
|
-695.17910
|
-594.303970
|
671.7118
|
-3.9357892
|
251.81
|
257.10
|
260.1086
|
0.0004091
|
0.2208346
|
-0.8611583
|
|
2018-01-09
|
652.6178
|
-1791.29506
|
-1138.677304
|
1212.3405
|
-4.9776631
|
253.94
|
246.35
|
259.8605
|
-0.0008182
|
0.2589307
|
-1.2808700
|
|
2018-01-10
|
650.7132
|
-1652.07217
|
-1001.359019
|
1063.8870
|
-4.2767678
|
254.33
|
249.30
|
259.6495
|
-0.0006364
|
0.2218538
|
-0.9408170
|
|
2018-01-11
|
667.2664
|
-1620.49312
|
-953.226706
|
1008.2097
|
-4.2137937
|
255.13
|
249.30
|
259.9029
|
-0.0007619
|
0.2360157
|
-0.9865214
|